home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / vgacodng / part08_a.pas < prev    next >
Pascal/Delphi Source File  |  1996-11-22  |  2KB  |  71 lines
  1. program ColorCyclePlasma;
  2.  
  3. uses crt;
  4.  
  5. var n       : byte;
  6.     Palette : array[0..767] of byte;
  7.  
  8. function newcol(mc,n,dvd:integer) : byte;
  9. begin
  10.   newcol := ((mc+n-random(n)) div dvd) mod 192;
  11. end;
  12.  
  13. procedure subdivide(x1,y1,x2,y2:word);
  14. var x,y,dxy,n1,n2,n3,n4 : word;
  15.  
  16. begin
  17.   if (x2-x1 < 2) and (y2-y1 < 2) then exit;
  18.   x := (x2+x1) div 2;
  19.   y := (y2+y1) div 2;
  20.   n1 := mem[$A000:320*y1+x1];
  21.   n2 := mem[$A000:320*y2+x1];
  22.   n3 := mem[$A000:320*y1+x2];
  23.   n4 := mem[$A000:320*y2+x2];
  24.   dxy := 5 * (x2-x1+y2-y1) div 3;
  25.   if mem[$A000:320*y1+x] = 0 then mem[$A000:320*y1+x] := newcol(n1+n3,dxy,2);
  26.   if mem[$A000:320*y+x1] = 0 then mem[$A000:320*y+x1] := newcol(n1+n2,dxy,2);
  27.   if mem[$A000:320*y+x2] = 0 then mem[$A000:320*y+x2] := newcol(n3+n4,dxy,2);
  28.   if mem[$A000:320*y2+x] = 0 then mem[$A000:320*y2+x] := newcol(n2+n4,dxy,2);
  29.   mem[$A000:320*y+x] := newcol(n1+n2+n3+n4,dxy,4);
  30.   subdivide(x1,y1,x,y);
  31.   subdivide(x,y1,x2,y);
  32.   subdivide(x1,y,x,y2);
  33.   subdivide(x,y,x2,y2);
  34. end;
  35.  
  36. procedure SetPal(col,r,g,b:byte);
  37. begin
  38.   port[$3C8] := col;
  39.   port[$3C9] := r;
  40.   port[$3C9] := g;
  41.   port[$3C9] := b;
  42. end;
  43.  
  44. procedure RotatePalette;
  45. var Temp : array[0..2] of byte;
  46.  
  47. begin
  48.   repeat
  49.     move(Palette,Temp,3);
  50.     move(Palette[3],Palette[0],765);
  51.     move(Temp,Palette[765],3);
  52.     for n := 0 to 255 do setpal(n,Palette[n*3],Palette[n*3+1],Palette[n*3+2]);
  53.   until keypressed;
  54. end;
  55.  
  56.  
  57. begin
  58.   randomize;
  59.   asm mov ax,13h; int 10h end;  { In Mode 13h schalten }
  60.   fillchar(Palette,768,0);      { Palette erstellen }
  61.   for n := 0 to 255 do begin
  62.     Palette[n*3+1] := n div 2;
  63.     Palette[n*3+2] := n;
  64.     setpal(n,0,n div 2,n);
  65.   end;
  66.   subdivide(0,0,319,199);       { Plasma aufbauen }
  67.   RotatePalette;                { Palette rotieren }
  68.   readkey;
  69.   asm mov ax,3; int 10h end;    { Zurück zum Textmodus }
  70. end.
  71.